home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / CircleText.pprx < prev    next >
Text File  |  1997-05-06  |  14KB  |  529 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: CircleText.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script draws a circular vector text.
  7.  
  8.  This is a "tool macro": the mouse can be used to define a circle; when
  9.  the mouse button is released, a settings requester is displayed. The
  10.  settings include: font, text string, text size, antialiasing, etc.
  11.  
  12.  If a single point (pixel) is selected instead of an area, the previous
  13.  circle coordinates remain in use. Other parameters allow the user
  14.  to adjust the appearance of the text.
  15.  
  16.  The text string specified in the settings requester may contain color
  17.  control sequences, in the format "Esc[3#m" or "[#]", where # is a pen
  18.  number (0 .. 256). The default (initial) color is the current foreground
  19.  color.
  20.  
  21.  By specifying a Frame setting greater than 1, it is possible to
  22.  create an animation sequence in which the circular text rotates
  23.  (the greater the number of frames, the smoother the rotation).
  24. */
  25.  
  26. /** DEU
  27.  Dieses Skript dient zur Ausrichtung eines Vektortexts an einer
  28.  Kreislinie.
  29.  
  30.  Dies ist ein sog. "Tool-Makro", d. h. zunächst wird mit Hilfe der Maus
  31.  der Kreis erstellt. Sobald die Maustaste losgelassen wird, öffnet
  32.  sich ein Dialogfenster zur Festlegung von Einstellungen für Font,
  33.  Textstring, Zeichengröße, Kantenglättung, usw.
  34.  
  35.  Wird anstelle eine Bereichs lediglich ein einzelner Punkt selektiert,
  36.  bleiben die vorherigen Kreiskoordinaten erhalten. Andere Parameter
  37.  ermöglichen dem Benutzer u.a. die Festlegung des Erscheinungsbildes
  38.  für den Text.
  39.  
  40.  Hinweis: Der im Einstellungen-Dialogfenster festgelegte Textstring kann
  41.  auch mit Steuerzeichen zur Aktivierung einer bestimmten Farbe versehen
  42.  werden. Diese müssen im Format "Esc[3#m]" oder "[#]" vorliegen, wobei das
  43.  Rautenzeichen # die Stiftnummer (0...256) angibt. Standardmäßig ist die
  44.  aktuelle Vordergrundfarbe eingestellt.
  45.  
  46.  Durch die Angabe eines Wertes >1 unter "Einzelbilder" läßt sich
  47.  eine Animation mit einem rotierenden Textkreis erzeugen. Dabei gilt:
  48.  Je größer die Anzahl der Einzelbilder, desto flüssiger der Ablauf
  49.  der Rotation.
  50.  
  51. */
  52.  
  53. /** ITA
  54.  Questo script disegna un testo vettoriale circolare.
  55.  
  56.  È una "macro per strumenti": si può usare il mouse per definire un cerchio;
  57.  quando si rilascia il tasto del mouse, compare una finestra di dialogo per
  58.  l'impostazione dei parametri. I parametri comprendono: font, stringa di
  59.  testo, dimensioni del testo, smorzamento seghettature (antialiasing), ecc.
  60.  
  61.  Se si seleziona un punto singolo (pixel) anziché un'area, rimangono in uso
  62.  le coordinate del cerchio precedente. Gli altri parametri permettono di
  63.  adattare l'aspetto del testo.
  64.  
  65.  La stringa di testo specificata nella finestra di dialogo delle impostazioni
  66.  può contenere sequenze di controllo per colori, nel formato "Esc[3#m" o "[#]",
  67.  dove # è il numero di un colore (0 .. 256). Il colore predefinito (iniziale)
  68.  è quello corrente di primo piano.
  69.  
  70.  Se si specifica per Fotogrammi un numero maggiore di 1, è possibile creare
  71.  una sequenza animata in cui il testo circolare ruota (quanto maggiore è il
  72.  numero di fotogrammi, tanto più fluida sarà la rotazione).
  73. */
  74.  
  75. IF ARG(1, EXISTS) THEN
  76.     PARSE ARG PPPORT button x0 y0 .
  77. ELSE
  78.     EXIT 0  /* macro execution only */
  79.  
  80. ADDRESS VALUE PPPORT
  81. OPTIONS RESULTS
  82. OPTIONS FAILAT 10000
  83.  
  84. Get 'LANG'
  85. IF RESULT = 1 THEN DO        /* Deutsch */
  86.     txt_title_zone    = "Kreisdefinition"
  87.     txt_gad_x0        = "Zentrum _X:"
  88.     txt_gad_y0        = "Zentrum _Y:"
  89.     txt_gad_radius    = "_Radius:"
  90.     txt_title_set     = "Kreistext-Einstellungen"
  91.     txt_gad_font      = "_Font:"
  92.     txt_gad_text      = "_Text:"
  93.     txt_string_text   = "Dieser Text verläuft im Kreis. "
  94.     txt_gad_height    = "_Höhe:"
  95.     txt_gad_frames    = "_Einzelbilder:"
  96.     txt_gad_sangle    = "A_nfangswinkel:"
  97.     txt_gad_aalias    = "_Kantenglättung:"
  98.     txt_gad_aalias0   = "Keine"
  99.     txt_gad_aalias1   = "Schwach"
  100.     txt_gad_aalias2   = "Mittel"
  101.     txt_gad_aalias3   = "Stark"
  102.     txt_err_nofonts   = "Vectorfonts nicht auffindbar"
  103.     txt_err_procss    = "Fehler bei Bildbearbeitung: "
  104.     txt_err_small     = "Kreis ist zu klein"
  105.     txt_err_nomem     = "Zu wenig Speicher"
  106.     txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
  107. END
  108. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  109.     txt_title_zone    = "Definizione cerchio"
  110.     txt_gad_x0        = "Centro _X:"
  111.     txt_gad_y0        = "Centro _Y:"
  112.     txt_gad_radius    = "_Raggio:"
  113.     txt_title_set     = "Parametri testo"
  114.     txt_gad_font      = "_Font:"
  115.     txt_gad_text      = "_Testo:"
  116.     txt_string_text   = "Questo è un testo circolare. "
  117.     txt_gad_height    = "Alte_zza:"
  118.     txt_gad_frames    = "Fotogra_mmi:"
  119.     txt_gad_sangle    = "Ang_olo iniziale:"
  120.     txt_gad_aalias    = "Antialia_s:"
  121.     txt_gad_aalias0   = "Nessuno"
  122.     txt_gad_aalias1   = "Basso"
  123.     txt_gad_aalias2   = "Medio"
  124.     txt_gad_aalias3   = "Alto"
  125.     txt_err_nofonts   = "Non vi sono font vettoriali"
  126.     txt_err_procss    = "Errore elaborazione immagine: "
  127.     txt_err_small     = "Il cerchio definito è troppo piccolo"
  128.     txt_err_nomem     = "Memoria insufficiente"
  129.     txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
  130. END
  131. ELSE DO                /* English */
  132.     txt_title_zone    = "Circle Definition"
  133.     txt_gad_x0        = "Center _X:"
  134.     txt_gad_y0        = "Center _Y:"
  135.     txt_gad_radius    = "_Radius:"
  136.     txt_title_set     = "Circle Text Settings"
  137.     txt_gad_font      = "_Font:"
  138.     txt_gad_text      = "_Text:"
  139.     txt_string_text   = "This is a circular text. "
  140.     txt_gad_height    = "_Height:"
  141.     txt_gad_frames    = "Fra_mes:"
  142.     txt_gad_sangle    = "Start _Angle:"
  143.     txt_gad_aalias    = "A_ntialias:"
  144.     txt_gad_aalias0   = "None"
  145.     txt_gad_aalias1   = "Low"
  146.     txt_gad_aalias2   = "Medium"
  147.     txt_gad_aalias3   = "High"
  148.     txt_err_nofonts   = "Vector fonts not found"
  149.     txt_err_procss    = "Image processing error: "
  150.     txt_err_small     = "The circle is too small"
  151.     txt_err_nomem     = "Not enough memory"
  152.     txt_err_oldclient = "This script requires a newer_version of Personal Paint"
  153. END
  154.  
  155. Version 'REXX'
  156. IF RESULT < 7 THEN DO
  157.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  158.     EXIT 10
  159. END
  160.  
  161. /* Circle Definition */
  162.  
  163. GetCurrentBrush
  164. savebsh = RESULT
  165. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  166.  
  167. prev_xp = x0
  168. prev_yp = y0
  169. drawn = 0
  170.  
  171. DO FOREVER
  172.     GetMousePosition
  173.     PARSE VAR RESULT xp yp .
  174.  
  175.     IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  176.         IF drawn THEN
  177.             Undo
  178.         GetDistance x0 y0 xp yp 'IMAGERATIO'
  179.         radius = RESULT
  180.         DrawCircle x0 y0 'RADIUSX' radius
  181.  
  182.         prev_xp = xp
  183.         prev_yp = yp
  184.         drawn = 1
  185.     END
  186.     ELSE WaitForEvent
  187.  
  188.     GetMouseButton
  189.     IF RESULT ~= button THEN
  190.         LEAVE
  191. END
  192.  
  193. Undo
  194. SetCurrentBrush savebsh
  195.  
  196.  
  197. FreeBrush
  198. IF RC ~= 0 THEN
  199.     EXIT RC
  200.  
  201. /* Setting Requester */
  202.  
  203. def_font_path = "FONTS:"
  204. max_text_size = 8000
  205.  
  206. font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
  207.  
  208.  
  209. ftot = 0
  210. vftfname = 'ENV:PP_VectorFonts'
  211. IF ~OPEN(fexists, vftfname) THEN DO
  212.     ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
  213.     ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
  214.     IF RC = 0 THEN DO
  215.         ADDRESS COMMAND 'Delete >NIL: 'vftfname
  216.         ADDRESS COMMAND 'Copy >NIL: 'vftfname'.s' vftfname
  217.         ADDRESS COMMAND 'Delete >NIL: 'vftfname'.s'
  218.     END
  219. END
  220. ELSE CALL CLOSE(fexists)
  221.  
  222. IF OPEN('listfile', vftfname) THEN DO
  223.     DO FOREVER
  224.         fline = READLN('listfile')
  225.         IF EOF('listfile') THEN BREAK
  226.         ftot = ftot + 1
  227.         fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
  228.     END
  229.     CALL CLOSE('listfile')
  230. END
  231.  
  232. IF ftot = 0 THEN DO
  233.     RequestNotify 'PROMPT "'txt_err_nofonts'"'
  234.     EXIT 10
  235. END
  236.  
  237.  
  238. IF radius < 2 THEN DO        /* simple click */
  239.     lastpar  = LoadSet('LastParams', '0 0 100')
  240.     PARSE VAR lastpar x0 y0 radius .
  241.     Request '"'txt_title_zone'" ' ||,
  242.             '"INTSTR = ""'txt_gad_x0'"", 0, 32000, 'x0' ' ||,
  243.              'INTSTR = ""'txt_gad_y0'"", 0, 32000, 'y0' ' ||,
  244.              'INTSTR = ""'txt_gad_radius'"", 1, 32000, 'radius' "'
  245.     IF RC ~= 0 THEN
  246.         EXIT RC
  247.     x0 = RESULT.1
  248.     y0 = RESULT.2
  249.     radius = RESULT.3
  250. END
  251.  
  252.  
  253. fntnum  = LoadSet('Font', 0)
  254. text    = LoadSet('Text', txt_string_text)
  255. height  = LoadSet('Height', 50)
  256. angle   = LoadSet('StartAngle', 0)
  257. aalias  = LoadSet('Antialias', 0)
  258. frames  = LoadSet('Frames', 0)
  259. last_height  = height
  260.  
  261. req = '"LIST = ""'txt_gad_font'"", 'ftot', 'fntnum', 20, 7'
  262. DO f = 1 TO ftot
  263.     req = req || ', ""' || fontname.f || '""'
  264. END
  265.  
  266. req = req ||,
  267.      ' VSPACE = 2 ' ||,
  268.       'STRING = ""'txt_gad_text'"", 'max_text_size', ""'text'"" ' ||,
  269.       'INTSTR = ""'txt_gad_height'"", 1, 32000, 'height' ' ||,
  270.       'INTSTR = ""'txt_gad_frames'"", 0, 32000, 'frames' ' ||,
  271.       'VSPACE = 2 ' ||,
  272.       'SLIDE = ""'txt_gad_sangle'"", -360, 360, 'angle' ' ||,
  273.       'VSPACE = 2 ' ||,
  274.         'CYCLE = ""'txt_gad_aalias'"", 4, 'aalias', ""'txt_gad_aalias0'"", ""'txt_gad_aalias1'"", ""'txt_gad_aalias2'"", ""'txt_gad_aalias3'"" ' ||,
  275.       'VSPACE = 2 "'
  276.  
  277. LockGUI
  278. Request 'RESIZE COMPACT "'txt_title_set'" 'req
  279. IF RC = 0 THEN DO
  280.     fntnum  = RESULT.1 + 1
  281.     text    = RESULT.2
  282.     height  = RESULT.3
  283.     frames  = RESULT.4
  284.     angle   = RESULT.5
  285.     aalias  = RESULT.6
  286.  
  287.     CALL SaveSet('Font', fntnum - 1)        /* setting persistence */
  288.     CALL SaveSet('Text', text)
  289.     CALL SaveSet('Height', height)
  290.     CALL SaveSet('StartAngle', angle)
  291.     CALL SaveSet('Antialias', aalias)
  292.     CALL SaveSet('Frames', frames)
  293.     CALL SaveSet('LastParams', x0 y0 radius)
  294.  
  295.     IF radius < 1 THEN DO
  296.         RequestNotify 'PROMPT "'txt_err_small'"'
  297.         len = 0
  298.     END
  299.  
  300.     angle = angle * 1000
  301.     IF angle < 0 THEN
  302.         angle = 360000 + angle
  303.     IF angle >= 360000 THEN
  304.         angle = angle - 360000
  305.  
  306.     GetPen 'FOREGROUND'
  307.     pen = RESULT
  308.     savepen = pen
  309.     SIGNAL ON Break_C
  310.  
  311.     tchar. = ''
  312.     tpen. = pen
  313.     tchars = ''
  314.     len = ParseText(text, pen)
  315.     totsize = 0
  316.  
  317.     last_metrics = LoadSet('Metrics', '')
  318.     last_tchars = LoadSet('TxChars', '')
  319.  
  320.     IF height == last_height & tchars == last_tchars THEN DO
  321.         DO c = 1 TO len
  322.             addx = WORD(last_metrics, c)
  323.             totsize = totsize + addx
  324.             size.c = addx
  325.         END
  326.     END
  327.     ELSE DO
  328.         metrics = ''
  329.         DO c = 1 TO len
  330.             nextc = c + 1
  331.             VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height
  332.             IF RC = 0 THEN DO
  333.                 PARSE VAR RESULT addx .
  334.                 totsize = totsize + addx
  335.                 size.c = addx
  336.                 metrics = metrics addx
  337.             END
  338.             ELSE DO
  339.                 RequestNotify 'PROMPT "'txt_err_nomem'"'
  340.                 EXIT 0
  341.             END
  342.         END
  343.         CALL SaveSet('Metrics', metrics)
  344.         CALL SaveSet('TxChars', tchars)
  345.     END
  346.     last = len + 1
  347.     size.last = 0
  348.  
  349.     GetImageAttributes 'DPIX'
  350.     dpix = RESULT
  351.     GetImageAttributes 'DPIY'
  352.     imgratio = dpix / RESULT
  353.     rx = radius
  354.     ry = TRUNC(radius / imgratio + 0.5)
  355.  
  356.     IF frames < 1 THEN
  357.         frames = 1
  358.     IF frames > 1 THEN
  359.         AddFrames 'FRAMES' frames
  360.     start_angle = angle
  361.     angle_step = 360000 % frames
  362.  
  363.     DO f = 1 TO frames
  364.         angle = start_angle
  365.         DO c = 1 TO len
  366.             GetEllipsePoint x0 y0 rx ry angle
  367.             PARSE VAR RESULT px py .
  368.  
  369.             nextc = c + 1
  370.             VectorCharacter 'CHARACTER "'tchar.c || tchar.nextc'" FONTPATH "'font_path'" FONTNAME "'fontname.fntnum'" HEIGHT 'height' ANGLE 'angle' ANTIALIAS 'aalias
  371.             IF RC = 0 THEN DO
  372.                 PARSE VAR RESULT . . handlex handley .
  373.  
  374.                 SetBrushAttributes 'HANDLEX 'handlex' HANDLEY 'handley
  375.                 SetPaintMode 'COLOR'
  376.                 SetPen 'FOREGROUND' tpen.c
  377.  
  378.                 IF aalias > 0 THEN DO
  379.                     Process 'IMAGE BRUSHMODE X0 'px' Y0 'py' FILTER "Brush Alpha Channel (Single)" NOFS'
  380.                     IF RC ~= 0 THEN DO
  381.                         IF RC ~= 5 THEN
  382.                             RequestNotify 'PROMPT "'txt_err_procss || RC'"'
  383.                         LEAVE
  384.                     END
  385.                 END
  386.                 ELSE PutBrush px py
  387.  
  388.                 angle = angle + TRUNC((size.c + size.nextc) / 2 / totsize * 360000 + 0.5)
  389.                 IF angle >= 360000 THEN
  390.                     angle = angle - 360000
  391.             END
  392.         END
  393.         IF frames > 1 THEN DO
  394.             start_angle = start_angle + angle_step
  395.             IF start_angle >= 360000 THEN
  396.                 start_angle = start_angle - 360000
  397.             SetFramePosition 'NEXT'
  398.         END
  399.     END
  400.     SetPen 'FOREGROUND' savepen
  401.     FreeBrush 'FORCE'
  402. END
  403. UnlockGUI
  404.  
  405. EXIT 0
  406.  
  407.  
  408.  
  409.  
  410. ParseText: PROCEDURE EXPOSE tchar. tpen. tchars
  411.  
  412.     tstring = ARG(1)
  413.     tpn = ARG(2)
  414.     tlen = LENGTH(tstring)
  415.     tchars = ''
  416.     tpos = 1
  417.     tnum = 0
  418.  
  419.     DO UNTIL tpos > tlen
  420.         td = SUBSTR(tstring, tpos, 1)
  421.         tnewpen = ''
  422.         IF td = '[' THEN DO    /* [###] */
  423.             tnewpos = tpos + 1
  424.             IF SUBSTR(tstring, tnewpos, 1) = '[' THEN
  425.                 tpos = tpos + 1
  426.             ELSE DO
  427.                 DO FOREVER
  428.                     tc = SUBSTR(tstring, tnewpos, 1)
  429.                     IF tc < '0' | tc > '9' THEN
  430.                         LEAVE
  431.                     tnewpen = tnewpen || tc
  432.                     tnewpos = tnewpos + 1
  433.                 END
  434.             END
  435.         END
  436.         ELSE IF C2D(td) = 27 THEN DO    /* Esc[3###m */
  437.             IF SUBSTR(tstring, tpos+1, 2) == '[3' THEN DO
  438.                 tnewpos = tpos + 3
  439.                 DO FOREVER
  440.                     tc = SUBSTR(tstring, tnewpos, 1)
  441.                     IF tc < '0' | tc > '9' THEN
  442.                         LEAVE
  443.                     tnewpen = tnewpen || tc
  444.                     tnewpos = tnewpos + 1
  445.                 END
  446.             END
  447.         END
  448.         ELSE IF td = '"' THEN
  449.             td = '""'
  450.  
  451.         IF tnewpen == '' THEN DO
  452.             tnum = tnum + 1
  453.             tchar.tnum = td
  454.             tpen.tnum = tpn
  455.             tchars = tchars || td
  456.             tpos = tpos + 1
  457.         END
  458.         ELSE DO
  459.             tpn = tnewpen
  460.             tpos = tnewpos + 1
  461.         END
  462.     END
  463.  
  464.     RETURN tnum
  465.  
  466.  
  467.  
  468.  
  469. SaveSet: PROCEDURE
  470.     sname = ARG(1)
  471.     val = ARG(2)
  472.  
  473.     IF OPEN('settingfile', 'ENV:PP_CircleTx_'sname, 'W') THEN DO
  474.         CALL WRITECH('settingfile', val)
  475.         CALL CLOSE('settingfile')
  476.     END
  477.  
  478.     RETURN
  479.  
  480.  
  481.  
  482.  
  483. LoadSet: PROCEDURE
  484.     sname = ARG(1)
  485.     def_val = ARG(2)
  486.     IF ARG() > 2 THEN
  487.         global_set = ARG(3)
  488.     ELSE
  489.         global_set = 0
  490.     IF ARG() > 3 THEN
  491.         request_quote = ARG(4)
  492.     ELSE
  493.         request_quote = 1
  494.  
  495.     val = def_val
  496.     IF global_set THEN
  497.         set_fname = 'ENV:'sname
  498.     ELSE
  499.         set_fname = 'ENV:PP_CircleTx_'sname
  500.  
  501.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  502.         val = READCH('settingfile', 65535)
  503.         CALL CLOSE('settingfile')
  504.     END
  505.  
  506.     IF request_quote THEN DO
  507.         /* encode quotes for the Request command ('"' -> '\""') */
  508.         qpos_start = 1
  509.         DO FOREVER
  510.             qpos = INDEX(val, '"', qpos_start)
  511.             IF qpos = 0 THEN BREAK
  512.             val = INSERT('\"', val, qpos-1)
  513.             qpos_start = qpos + 3
  514.         END
  515.     END
  516.  
  517.     RETURN val
  518.  
  519.  
  520.  
  521.  
  522. Break_C:
  523.  
  524.     SetPen 'FOREGROUND' savepen
  525.     FreeBrush 'FORCE'
  526.     UnlockGUI
  527.  
  528.     RETURN
  529.